home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / pastutor.EXE / tutor03a.pas < prev    next >
Pascal/Delphi Source File  |  1998-04-02  |  3KB  |  101 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision 2.0 Demo                        }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program Tutor03a;
  9.  
  10. uses TutConst, Drivers, Objects, Views, Menus, App;
  11.  
  12. type
  13.   TTutorApp = object(TApplication)
  14.     procedure HandleEvent(var Event: TEvent); virtual;
  15.     procedure InitMenuBar; virtual;
  16.     procedure InitStatusLine; virtual;
  17.   end;
  18.  
  19. procedure TTutorApp.HandleEvent(var Event: TEvent);
  20. var
  21.   R: TRect;
  22. begin
  23.   inherited HandleEvent(Event);
  24.   if Event.What = evCommand then
  25.   begin
  26.     case Event.Command of
  27.       cmOptionsVideo:
  28.         begin
  29.           SetScreenMode(ScreenMode xor smFont8x8);
  30.           ClearEvent(Event);
  31.         end;
  32.     end;
  33.   end;
  34. end;
  35.  
  36. procedure TTutorApp.InitMenuBar;
  37. var
  38.   R: TRect;
  39. begin
  40.   GetExtent(R);
  41.   R.B.Y := R.A.Y + 1;
  42.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  43.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  44.       StdFileMenuItems(nil)),
  45.     NewSubMenu('~E~dit', hcNoContext, NewMenu(
  46.       StdEditMenuItems(
  47.       NewLine(
  48.       NewItem('~S~how clipboard', '', kbNoKey, cmClipShow, hcNoContext,
  49.       nil)))),
  50.     NewSubMenu('~O~rders', hcNoContext, NewMenu(
  51.       NewItem('~N~ew', 'F9', kbF9, cmOrderNew, hcNoContext,
  52.       NewItem('~S~ave', '', kbNoKey, cmOrderSave, hcNoContext,
  53.       NewLine(
  54.       NewItem('Next', 'PgDn', kbPgDn, cmOrderNext, hcNoContext,
  55.       NewItem('Prev', 'PgUp', kbPgUp, cmOrderPrev, hcNoContext,
  56.       nil)))))),
  57.     NewSubMenu('O~p~tions', hcNoContext, NewMenu(
  58.       NewItem('~T~oggle video', '', kbNoKey, cmOptionsVideo, hcNoContext,
  59.       NewItem('~S~ave desktop', '', kbNoKey, cmOptionsSave, hcNoContext,
  60.       NewItem('~L~oad desktop', '', kbNoKey, cmOptionsLoad, hcNoContext,
  61.       nil)))),
  62.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  63.       NewItem('Orders', '', kbNoKey, cmOrderWin, hcNoContext,
  64.       NewItem('Stock items', '', kbNoKey, cmStockWin, hcNoContext,
  65.       NewItem('Suppliers', '', kbNoKey, cmSupplierWin, hcNoContext,
  66.       NewLine(
  67.       StdWindowMenuItems(nil)))))),
  68.     NewSubMenu('~H~elp', hcNoContext, NewMenu(
  69.       NewItem('~A~bout...', '', kbNoKey, cmAbout, hcNoContext,
  70.       nil)),
  71.     nil))))))
  72.   )));
  73. end;
  74.  
  75. procedure TTutorApp.InitStatusLine;
  76. var
  77.   R: TRect;
  78. begin
  79.   GetExtent(R);
  80.   R.A.Y := R.B.Y - 1;
  81.   New(StatusLine, Init(R,
  82.     NewStatusDef(0, $EFFF,
  83.       NewStatusKey('~F3~ Open', kbF3, cmOpen,
  84.       NewStatusKey('~F4~ New', kbF4, cmNew,
  85.       NewStatusKey('~Alt+F3~ Close', kbAltF3, cmClose,
  86.       StdStatusKeys(nil)))),
  87.     NewStatusDef($F000, $FFFF,
  88.       NewStatusKey('~F6~ Next', kbF6, cmOrderNext,
  89.       NewStatusKey('~Shift+F6~ Prev', kbShiftF6, cmOrderPrev,
  90.       StdStatusKeys(nil))), nil))));
  91. end;
  92.  
  93. var
  94.   TutorApp: TTutorApp;
  95.  
  96. begin
  97.   TutorApp.Init;
  98.   TutorApp.Run;
  99.   TutorApp.Done;
  100. end.
  101.